          PH.ARGS DRPT,SD,ED,BATCH,BRCHS,BR,SET.STAT,SORT.OPTN,SBR,SHOW.AR,FITEM,COST.TYPE,NEW.BATCH.ID,SERIAL,XFER.OPT
** Version# 77.0302[30] - 01/14/2014 - 10:41am - TSMITH - eclipse
*** V77.0302 Change - Custom Coding . - 01/14/2014 - TSMITH - eclipse
** Copied from BP PRC.PHR.INV.PREVIEW Version# 77.03 - 10/31/2011 - 11:11am - EILEENM - r8.6base
*** V77.03 Change - Add FULL Ver 81 - 10/31/2011 - EILEENM - r8.6base
*** V77.02 Change - Add FULL Ver 80 - 02/18/2011 - CASEY - r8.6base
*** V77.01 Change - Add FULL Ver 79 - 02/15/2008 - KEVINM - r8.6base

*** Program: PRC.PHR.INV.PREVIEW
*-------------------------------------------------------------------------*
*** Detailed Invoice Preview report
*-------------------------------------------------------------------------*
*** Parameters:
***       SD          -  Start Date                                   (IN)
***       ED          -  End Date                                     (IN)
***       BATCH       -  Batch ID                                     (IN)
***       BRCHS       -  Branches                                     (IN)
***       BR          -  Literal entered by user for Branches         (IN)
***       SET.STAT    -  Set print status - Y sets print status to B  (IN)
***       SORT.OPT    -  Sort options                                 (IN)
***       SBR         -  Shipping/Pricing Branch                      (IN)
***       SHOW.AR     -  Show AR data                                 (IN)
***       FITEM       -  Filter Input item                            (IN)
***       COST.TYPE   -                                               (IN)
***       NEW.BATCH.ID-  New batch ID                                 (IN)
***       SERIAL
***       XFER.OPT    - Include, Exclude, Only Transfers              (IN)
*-------------------------------------------------------------------------*
** Changed cost and GP% basis to Commission Cost (LD(27))
** Added Aging and Avail qty
** Pass cost type to select LD(10) OR LD(27)
**************************************************
          ALT.DESC = ''
          TGT      = ''
          CURR.FLG = NO
          BASE.CUR = YES
          IF DRPT<51> THEN
             READ BASEC FROM CTRLFILE,"BASE.CURRENCY" ELSE BASEC = ''
             IF DRPT<51> # BASEC THEN
                TGT = DRPT<51>
                CURR.FLG = YES
                BASE.CUR = NO
             END
          END

          DIM AGT(10)

          IF FITEM = '' THEN FILTER.FLAG=NO ELSE FILTER.FLAG=YES

          IMG.COUNTER   = 0

          GRAND.SBTOTAL = 0
          GRAND.COST    = 0
          GRAND.ADJ     = 0
          GRAND.GP      = 0
          GRAND.ADJ.GP  = 0

          UT.OPEN.COMMON.FILE 'IMG.XREF',HNDL.NUMBER
          IF HNDL.NUMBER THEN
             IMGFILE = FILES(HNDL.NUMBER)
             IMAGING = YES
          END ELSE
             IMAGING = NO
          END

          QSIGN     = -1
          PRNT.COST = 1

          BEGIN CASE
          CASE COST.TYPE = 1
             COST.HDR    = 'Cost....  '
             COST.BASE   = 27
          CASE COST.TYPE = 2
             COST.HDR    = 'CogsCost  '
             COST.BASE   = 10
          CASE OTHERWISE;
             COST.HDR    = '          '
             COST.BASE   = 10
             PRNT.COST   = 0
          END CASE

          BRS = BR
          IF OCONV(BATCH,'MCU') = 'ALL' THEN BATCH = ''
          BATCH.MODE = (SD='')

          SORT.OPT = SORT.OPTN[1,1]
          SDT      = OCONV(SD,'D4/')
          EDT      = OCONV(ED,'D4/')

          *** Set the report Title...
          IF DRPT<33>  = '' THEN
             TITLE     = 'Detailed Inv Preview '
             IF BATCH.MODE THEN
                TITLE := ' - Batch : ':BATCH:' Thru ':EDT
             END ELSE
                TITLE := ' for ':SDT:' - ':EDT
             END
          END ELSE
             TITLE    := DRPT<33>:'  ':SDT:' - ':EDT
          END

*-------------------------------------------------------------------------*
          *** Update our Phantom Status...
          WRITE 'Selecting...' ON PHSTFILE,PID$

          *** Go Select the data for the report...
          GOSUB SEL.IDS

          *** If we didn't get any data for the report...
          IF IDS = '' THEN
             REPORT.STATUS.MSG = ' - No Items Found'
             GOTO FINISH
          END

          *** Update our Phantom Status...
          WRITE 'Spooling...' ON PHSTFILE,PID$
*-------------------------------------------------------------------------*
          *** Build our report Heading and print the report...

          HDG = 'Detailed Invoice Preview for '
          IF BATCH.MODE THEN
             HDG := 'Batch : ':BATCH:' Thru ':EDT:' - Sortby : '
          END ELSE
             HDG := SDT:' to ':EDT:' - Batch : ':BATCH:' - Sortby : '
          END
          HDG := SORT.OPTN:' - Set Print : ':'NY'[SET.STAT+1,1]

          HDG = HDG"L#119":'Page^####'

          HDG<1,2> = 'Transfers: ':XFER.OPT:' ':'Branches : '
          BRANCH.ALLOW = (132 - LEN(HDG<1,2>))
          IF LEN(BRS) > BRANCH.ALLOW THEN BRS = BRS[1,BRANCH.ALLOW]:'...'
          HDG<1,2> := BRS:SPACE(10):SBR

          IF CURR.FLG THEN
             HDG<1,3> = 'Report Currency:  ':TGT
             HDG<1,4> = STR('-',130)
          END ELSE
             HDG<1,3> = STR('-',130)
          END

          PRINTER.ON 132,TITLE,DOC.ID,HDG,RPT.DFLT=DRPT

          *** Print any 'Additional Select' values the User specifiecd...
          FILTER.PRINT 'S',FITEM

          STATUS  = 'S':VM:'N':VM:'M':VM:'D':VM:'R':VM
          STATUS := 'C':VM:'P':VM:'T':VM:'L'

          PRINT.CT = 0
          IDN      = DCOUNT(IDS,AM)


          FOR IDX = 1 TO IDN
             GOSUB ONE.ID
          NEXT IDX


          IF IMAGING THEN
             IMAGE.STRING  = 'Number of Invoices printed : ':PRINT.CT
             IMAGE.STRING := '   Number of Invoices with Images : '
             IMAGE.STRING := IMG.COUNTER

             PRINT IMAGE.STRING
          END

          PRINT

          GRAND.ADJ = GRAND.ADJ/100
          IF GRAND.SBTOTAL # 0 THEN
             GRAND.GP     = 100*(GRAND.SBTOTAL - GRAND.COST)/GRAND.SBTOTAL
             GRAND.ADJ.GP = 100*(GRAND.SBTOTAL - GRAND.ADJ)/GRAND.SBTOTAL
          END

          PRINT 'Total Sales : '       :GRAND.SBTOTAL:SPACE(5):
          PRINT 'Total Cost : '        :GRAND.COST   :SPACE(5):
          PRINT 'Total GP% : '         :GRAND.GP     "L2#9":' ':
          PRINT 'Total Adjusted GP% : ':GRAND.ADJ.GP "L2#9"

*** Turn our Printer off and clean up after ourselves...
          PRINTER.OFF DOC.ID

          REPORT.STATUS.MSG = ' is complete.'

FINISH:   UT.PH.CLEANUP

          *** Tell the User that the report is finished...
          SEND.MESSAGE 'Phantom',USER.ID,TITLE:REPORT.STATUS.MSG

          STOP
*-------------------------------------------------------------------------*
ONE.ID:   ID  = IDS<IDX>
          OID = FIELD(ID,'.',1)
          GID = FIELD(ID,'.',2)
          SUPP.SORT = TRANS('LEDGER.GPS',OID,2,'FALSE')
          IF SUPP.SORT = "1" THEN
          GOTO ONE.ID.ORIG
          END


          MATREAD LED FROM LEDFILE,OID ELSE MAT LED=''

          LOCATE GID IN LED(12)<1> SETTING GEN ELSE RETURN
          IF LED(6)<1,GEN>='X' THEN RETURN
          SAVE.COMMENT = ''

          GOSUB HEADLINE

          LDIDS = RAISE(LED(48)<1,GEN>)
          LDN   = DCOUNT(LDIDS,VM)
          SRT.LOCS = ''
          SRT.LDIDS= ''
          PRT.LDIDS = LED(48)<1,GEN>
             CONVERT SVM TO AM IN PRT.LDIDS

          LD.CT = DCOUNT(PRT.LDIDS,AM)
          FOR J = 1 TO LD.CT
           LDID  = PRT.LDIDS<J>
                LD.GET LDID
                PN = LD(1)
                IF PN # '' AND (NUM(PN) OR PN = 'C' OR PN[1,2] = "L#") THEN
                   IF PN = 'C' THEN LOC = '*' ELSE
                      LOC = LD(7)<1,GEN,1>
                      LOC = FIELD(LOC,'~',2)
                      IF LOC = '' THEN
                         PRD.LOCATION.GET PRI.LOC,PN,SHIP.BR
                         LOC = PRI.LOC
                      END
                   END
                   IF LOC = '' THEN LOC = 'ZZZ'
                   LOC := J "R%4"
                   LOCATE LOC IN SRT.LOCS BY 'AL' SETTING POS ELSE NULL
                   SRT.LOCS  = INSERT(SRT.LOCS,POS;LOC)
                   SRT.LDIDS = INSERT(SRT.LDIDS,POS;LDID)
                END
             NEXT J
             PRT.LDIDS = SRT.LDIDS

*******************
          LDID.CT = DCOUNT(PRT.LDIDS,AM)
          FOR LD.NO = 1 TO LDID.CT
             LDID   = PRT.LDIDS<LD.NO>
             GOSUB ONE.PN
          NEXT LD.NO


          OE.ORDER.TOTAL OID:VM:BASE.CUR,GEN,QSIGN,TOTAL,SUB.TOL,FGHT,HNDL,TAX.TOL,FET.TOL
          TAX.TOL += FET.TOL
          IF CURR.FLG THEN
             CONV.CURR.LED TGT,GEN
          END

          BIL.INFRT   = LED(36)<1,GEN,3>*QSIGN
          BIL.OUTFRT  = LED(36)<1,GEN,4>*QSIGN
          BIL.INHNDL  = LED(36)<1,GEN,7>*QSIGN
          BIL.OUTHNDL = LED(36)<1,GEN,8>*QSIGN
          EXP.INFRT   = LED(36)<1,GEN,5>*QSIGN
          EXP.OUTFRT  = LED(36)<1,GEN,6>*QSIGN
          EXP.INHNDL  = LED(36)<1,GEN,9>*QSIGN
          EXP.OUTHNDL = LED(36)<1,GEN,10>*QSIGN
          GRAND.SBTOTAL += OCONV(SUB.TOL,'MR2')

          PRINT
          PRINT 'Subtotal :':OCONV(SUB.TOL,'MR2')         "R2#10":'  ':
          PRINT 'Tax :':OCONV(TAX.TOL,'MR2')              "R2#10":'  ':
          PRINT 'Freight :':OCONV(FGHT,'MR2')             "R2#10":'  ':
          PRINT 'Handling : ':OCONV(HNDL,'MR2')           "R2#10":'  ':
          INV.AMT = SUB.TOL + FGHT + HNDL + TAX.TOL
          PRINT 'Invoice Total : ':OCONV(INV.AMT,'MR2')   "R2#10":'  ':

*******************
          IF PRNT.COST THEN
             IF COST.TYPE=2 THEN
                ADJ.COGS = -LED(16)<1,GEN>
             END ELSE
                ADJ.COGS = -LED(17)<1,GEN>
             END
             TOL.COGS = ADJ.COGS - EXP.INFRT - EXP.OUTFRT - EXP.INHNDL - EXP.OUTHNDL

             GRAND.COST += (TOL.COGS/100)
             PRINT 'Goods GP % ':
             IF SUB.TOL=0 THEN GP=0 ELSE
                GP = 100*(SUB.TOL-TOL.COGS)/SUB.TOL
                IF GP <= -1000 THEN GP = -999
                IF GP >= 10000 THEN GP = 9999
             END
             PRINT GP "R0#4"
          END ELSE
             PRINT
          END

*** Print freight and handling break out
          PRINT "Freight and Handling Distribution :"
          PRINT "Freight In :": OCONV(BIL.INFRT ,'MR2')   "R2#10":'  ':
          PRINT "Freight Out :":OCONV(BIL.OUTFRT,'MR2')   "R2#10":'  ':
          PRINT "Handling In :": OCONV(BIL.INHNDL ,'MR2')  "R2#10":'  ':
          PRINT "Handling Out :":OCONV(BIL.OUTHNDL,'MR2')  "R2#10":'  ':
          IF PRNT.COST THEN
             PRINT '             Adj GP % ':
             GRAND.ADJ += ADJ.COGS
             IF SUB.TOL=0 THEN AGP=0 ELSE
                AGP = 100*(SUB.TOL-ADJ.COGS)/SUB.TOL
                IF AGP <= -1000 THEN AGP = -999
                IF AGP >= 10000 THEN AGP = 9999
             END
             PRINT AGP "R0#4"
             PRINT "Exp Frt In :":OCONV(EXP.INFRT,'MR2')     "R2#10":'  ':
             PRINT "Exp Frt Out :":OCONV(EXP.OUTFRT,'MR2')   "R2#10":'  ':
             PRINT "Exp Hndl In :":OCONV(EXP.INHNDL,'MR2')  "R2#10":'  ':
             PRINT "Exp Hndl Out :":OCONV(EXP.OUTHNDL,'MR2') "R2#10":'  '
          END ELSE
             PRINT
          END

          READ ARREC FROM ARFILE,OID:'.':LED(8)<1,GEN>"R%3" ELSE ARREC = ''
          ASUB.GET.AMT PAMT,ARREC,2,,GL.AUTO.AR
          IF PAMT THEN
             PRINT STR(' ',82):
             PRINT '** Amount Paid : ':PAMT "R26,#10"
          END
          PRINT
          PRINT STR('*',120)
          PRINT

          PRINT.CT = PRINT.CT + 1

          RETURN
*-------------------------------------------------------------------------*
ONE.PN:   *LDID = LDIDS<1,LD.NO>

                       IF NUM(LDID) THEN
                       LD.GET LDID
             IF CURR.FLG THEN
                CONV.CURR.LD TGT,GEN
             END

             BEGIN CASE
             * If Product Number or Job Managment Line Item
             CASE NUM(LD(1)) OR LD(1)[1,2] = "L#"
                PN   = LD(1)
                OE.GET.LI.OVRD.FLAG '1',GEN,GEN,OVRD.FLG,LDID,1
                PRC.OVRD.TYP = OVRD.FLG
                OE.GET.LI.OVRD.FLAG '2',GEN,GEN,OVRD.FLG,LDID,1
                COGS.OVRD.TYP = OVRD.FLG
                OE.GET.LI.OVRD.FLAG '3',GEN,GEN,OVRD.FLG,LDID,1
                COST.OVRD.TYP = OVRD.FLG
                GET.ALL.PRD BR,PN
                QTY  = -(SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>))
                OE.CALC.QOPEN OID,QSIGN,QOPEN
                QOPEN += QTY
                NP   = LD(8)<1,GEN>+0
                CST  = LD(COST.BASE)<1,GEN>+0
*************************
                IQP  = LD(9)<1,GEN>
                STAT = PRD(3)
                STS  = STATUS<1,STAT>
                BASN = LD(15)<1,GEN,2>
                IF BASN THEN
                   BEGIN CASE
                   CASE BASN = 21;      BASN = 'Lnd Cost'
                   CASE BASN = 22;      BASN = 'Avg Lnd'
                   CASE BASN = 25;      BASN = 'Order COGS'
                   CASE BASN = 28;      BASN = 'Order Comm'
                   CASE OTHERWISE
                      BASN = PLNE(2)<1,BASN>
                   END CASE
                   FORM = LD(15)<1,GEN,1>
                END ELSE
                   BASN = ''
                   FORM = ''
                END
                IF PRD(3) = '9' THEN IS.LOT = YES ELSE IS.LOT = NO
                GOSUB PR.PN
                IF IS.LOT THEN GOSUB PRT.LOT
             CASE LD(1) = 'C'
                SAVE.COMMENT = RAISE(LD(3))
                DCT = DCOUNT(SAVE.COMMENT,VM)

                *** Precede the first line of our Comment with an asteric
                *** so that they stand out from other types of Comments...
                PRINT SPACE(19):'*':SAVE.COMMENT<1,1>  "L#35"

                *** Print the rest of our comment lines...
                FOR JJ = 2 TO DCT
                   PRINT SPACE(19):SAVE.COMMENT<1,JJ>  "L#35"
                NEXT JJ
                SAVE.COMMENT = ''
             CASE LD(1) = 'S'
                SAVE.COMMENT = ''
             END CASE
          END

          RETURN
*-------------------------------------------------------------------------*
PR.PN:    *
          OE.DESC.GET DESC,ALT.DESC,'SOE'

          *** Print List of Serial numbers only if the option to print
          *** them was selected.
          IF SERIAL THEN
             IF LD(32)<1,GEN> THEN
                SERIAL.CT = DCOUNT(LD(32)<1,GEN>,SVM)
                FOR SCT = 1 TO SERIAL.CT
                   DESC<1,-1> = 'Serial # ':LD(32)<1,GEN,SCT>
                NEXT SCT
             END
          END

          DLN = DCOUNT(DESC,VM)

          FOR DLX=1 TO DLN
             IF DLX=1 THEN
                PRICE.PER.GET PER.QTY,PER.UM
                TYP = FIELD(LD(7)<1,GEN,1>,'~',1)[1,1]
                IQ.TO.ALPHA PLNE(3),PRD(7),LD(23),QTY,Q1,U1,Q2,U2,QS.ALPHA
                PRINT ' ':TYP"L#4":TRIM(QS.ALPHA)"L#10":' ':STS"L#3":
                PRINT DESC<1,DLX>                      "L#35":
                PRINT ' ':PER.UM                      "L#2":
                IF LD(9)<1,GEN>#'' THEN
                   PRINT OCONV(IQP*PER.QTY,'MR9')      "R3#10":
                END ELSE PRINT ''                      "L#10":
                PRINT OCONV(NP*PER.QTY, 'MR9')         "R3#10":PRC.OVRD.TYP "L#1":
                EXT = ICONV(OCONV(NP*QTY,'MR9'),'MR2')

                IF COST.TYPE = 1 THEN
                   IF PRNT.COST THEN
                      PRINT OCONV(CST*PER.QTY,'MR9')   "R3#10":COST.OVRD.TYP "L#1":
                   END
                END ELSE
                   IF PRNT.COST THEN
                      PRINT OCONV(CST*PER.QTY,'MR9')   "R3#10":COGS.OVRD.TYP "L#1":
                   END
                END

                PRINT OCONV(EXT,'MR2')                  "R2#10":
                IF PRNT.COST THEN
                   IF NP=0 THEN GP=0 ELSE
                      GP = 100*(NP-CST)/NP
                      IF GP <= -1000 THEN GP = -999
                      IF GP >= 10000 THEN GP = 9999
                   END
                   PRINT GP                             "R0#4":
                END

                IF NOT(IS.LOT) THEN
                   PRINT '  ':
                   PRINT BASN                              "L#9":' ':
                   PRINT FORM                              "L#10":
                   CALC.AVAIL AVAIL,DATE(),LED(2)<1,GEN,2>,PN
                   PRINT AVAIL                             "R,#7"
                END ELSE
                   PRINT
                END
             END ELSE
                PRINT SPACE(19):DESC<1,DLX>             "L#40"
             END
          NEXT DLX

          RETURN
*-------------------------------------------------------------------------*
PRT.LOT:  *
          *** Check for lot with items on this GEN
          VALID.LOT = NO
          GOSUB CHK.LOT
          IF NOT(VALID.LOT) THEN
             PRINT SPACE(19):"This specific Lot Shipment has no  "
             PRINT SPACE(19):"related Material Detail defined.   "
             RETURN
          END

!         PRINT SPACE(20):"******This Lot Consists of the*****"
!         PRINT SPACE(20):"****** Following items.       *****"
!         PRINT SPACE(20):"This Lot Consists of the Following:"
          PRINT SPACE(19):"** This Lot Shipment Consists of: **"


          PARTS.CT = DCOUNT(LD(59),VM)
          FOR LCT = 1 TO PARTS.CT

          *** Get Lot components
          PARTS.NUM = LD(59)<1,LCT>
          CONVERT SVM TO VM IN PARTS.NUM
          PARTS.ORD = LD(60)<1,LCT>

          *** Only print items on this GEN
          PARTS.SHP = LD(61)<1,LCT,GEN>
          IF PARTS.SHP+0 = 0 THEN CONTINUE

          *** Check for NULL price
          PARTS.PRC = OCONV(LD(62)<1,LCT>,'MR3')
          IF PARTS.PRC+0 = 0 THEN PARTS.PRC = 'N/A'

          *** Check for NULL cost
          PARTS.CST = OCONV(LD(63)<1,LCT>,'MR3')
          IF PARTS.CST+0 = 0 THEN PARTS.CST = 'N/A'

          IF NUM(PARTS.PRC) THEN
             PARTS.EXT = PARTS.PRC * PARTS.SHP
          END ELSE
             PARTS.EXT = 'N/A'
          END

          STS = ''
          PER.UM = ''
          REG.PRC = ''
          IF PARTS.NUM[1,1] = '/' THEN
             LPN = PARTS.NUM
             CONVERT '/' TO '' IN LPN
             GET.ALL.PRD BR,LPN
             PRICE.PER.GET PER.QTY,PER.UM
             PARTS.NUM = PRD(1)<1,1>
          END
          TYP = ''

          LDESC.CT = DCOUNT(PARTS.NUM,VM)
          FOR LL = 1 TO LDESC.CT

          IF LL = 1 THEN
             PRINT ' ':TYP"L#4":PARTS.SHP "L#10":' ':STS   "L#3":
             PRINT PARTS.NUM<1,LL>                        "L#35":
             PRINT '  ':PER.UM                            "L#2":
             PRINT REG.PRC                                "R3#10":
             PRINT PARTS.PRC                              "R3#10":
             IF PRNT.COST THEN
                PRINT PARTS.CST                           "R3#10":
             END

             PRINT PARTS.EXT                              "R2#10":

             PRINT
          END ELSE
             PRINT SPACE(19):PARTS.NUM<1,LL>              "L#35"
          END
          NEXT LL
          NEXT LCT

          RETURN
*-------------------------------------------------------------------------*
CHK.LOT:  *
          *** Loop through Lot looking for items on this GEN
          PARTS.CT = DCOUNT(LD(59),VM)
          FOR LCT = 1 TO PARTS.CT
             PARTS.SHP = LD(61)<1,LCT,GEN>
             IF PARTS.SHP+0 > 0 THEN VALID.LOT = YES; EXIT
          NEXT LCT

          RETURN
*-------------------------------------------------------------------------*
HEADLINE: BR = LED(2)<1,GEN,1>
          GET.CUS BR,LED(1)<1,GEN>,LED(5)<1,GEN>,QSIGN
          INVN = LED(8)<1,GEN>
          ORN  = OID:'.':INVN"R%3"
          READV PRT.STAT FROM LEDLFILE,OID,9 ELSE PRT.STAT = ''
          AR.MATREAD ORN
          IF CURR.FLG THEN
             CONV.CURR.AR TGT
          END
          DISC.AMT   = AR(9)<1,1>
          IF DISC.AMT = '' OR NOT(NUM(DISC.AMT)) THEN DISC.AMT = 0
          *-- Displays image indicator if images exist. --*
          IMAGE.FLAG = ''
          IF IMAGING THEN
             ROOT = 'L~':ORN
             BSCAN REC.ID,REC.VAL FROM IMGFILE,ROOT USING '&INDEX&.XREFS' ELSE NULL
             IF REC.ID = ROOT THEN
                IMAGE.FLAG = YES
             END ELSE
                PRE.ID = FIELD(ORN,'.',1)
                ROOT = 'L~':PRE.ID
                BSCAN REC.ID,REC.VAL FROM IMGFILE,ROOT USING '&INDEX&.XREFS' ELSE NULL
                IF REC.ID = ROOT THEN
                   IMAGE.FLAG = YES
                END ELSE
                   ROOT = ROOT:'.000'
                   BSCAN REC.ID,REC.VAL FROM IMGFILE,ROOT USING '&INDEX&.XREFS' ELSE NULL
                   IF REC.ID = ROOT THEN IMAGE.FLAG = YES
                END
             END
          END
          *--                                           --*
          IF DISC.AMT+0=0 THEN DISC.AMT='' ELSE DISC.AMT=-(DISC.AMT)
          READV LEDL17 FROM LEDLFILE,OID,17  ELSE LEDL17   = ''
          MNFST.ID = LEDL17<1,GEN>
          IF IMAGE.FLAG THEN
             PRINT 'Invoice # ':ORN "L#14":' * '    "L#8":
             IMG.COUNTER += 1
          END ELSE
             PRINT 'Invoice # ':ORN                 "L#20":
          END
          INSLMN = OCONV(LED(34)<1,GEN>,'TINITIALS;X;3;3')
          OTSLMN = OCONV(LED(72)<1,GEN>,'TINITIALS;X;3;3')
          PRINT 'Inside Sales: ':INSLMN           "L#23":' ':
          PRINT 'Outside Sales: ':OTSLMN          "L#23":'  ':
          PRINT 'Print Status : ':PRT.STAT<1,GEN> "L#10"
          PRINT 'Bill to : ':CUS(1)               "L#40":
          PRINT 'Ship to : ':CUSS(1)              "L#48":
          PRINT 'Terms   : ':LED(29)<1,GEN>       "L#10"
          PRINT '          ':CUS(2)<1,1>          "L#40":
          PRINT '          ':LED(78)<1,GEN,1>     "L#48":
          PRINT 'Disc Amt: ':OCONV(DISC.AMT,"MR2")"R2Z#10"
          PRINT '          ':CUS(3)"L#15":' ':CUS(4)"L#3":' ':CUS(5)"L#20":
          PRINT '          ':TRIM(LED(78)<1,GEN,3>):" ":LED(75)<1,GEN>"L#28":
          PRINT 'Inv Slct: ':CUSS(51)            "L#10"
          PRINT 'Shipdate: ':OCONV(LED(9)<1,GEN>,'D2/')"L#20":
          PRINT 'Stk Br # ':LED(2)<1,GEN,2>"L#16":
          WRITER = OCONV(LED(73)<1,GEN>,'TINITIALS;X;3;3')
          PRINT 'Writer: ':WRITER"L#20":
          PRINT 'Tax Jurisdiction: ':LED(79)<1,GEN,1>
          PRINT 'Batch # : ':LED(28)<1,GEN>"L#20":
          PRINT 'PO # ':LED(13)<1,GEN>"L#20":
          IF LED(69)<1,GEN,1> THEN
             FGT.ALL = 'YES'
          END ELSE
             FGT.ALL = 'NO'
          END
          PRINT 'Freight Allowed: ':FGT.ALL"L#15":' ':
          PRINT 'Price Class: ':LED(37)<1,GEN,1>"L#7":
          PRINT 'Manifest: ':MNFST.ID"L#8"
          PRINT 'Ship Via: ':LED(70)<1,GEN>"L#16"
          SHP.INS = LED(74)<1,GEN>
          IF SHP.INS#'' THEN
             PRINT 'Shipping Instr : ':SHP.INS<1,1,1> "L#40"
             CT = DCOUNT(SHP.INS,SVM)
             FOR J = 2 TO CT
                PRINT SPACE(17):SHP.INS<1,1,J> "L#40"
             NEXT J
          END

          IF SHOW.AR THEN
             AR.LASTTRANS LED(5)<1,GEN>,DATE(),'C',LPDATE,LPREF,LPAMT
             AR.PREV.LIST LED(5)<1,GEN>,DATE(),DATE(),MAT AGT
             BAL = AGT(1)+AGT(2)+AGT(3)+AGT(4)+AGT(5)+AGT(6)+AGT(7)
             PRINT
             *** Print bucket titles - Type 1 for 6 AM bucket names
             BUCKETS = AR.AGING.BUCKET.NAMES(1)
             PRINT '   Balance...':
             FOR J = 1 TO 6
                PRINT '  ':BUCKETS<J> "11.L":
             NEXT J
             PRINT '     Deposits  --  Last PayDt : ':OCONV(LPDATE,'D4/')
             PRINT BAL                      "R26#13":
             FOR J = 1 TO 7
                PRINT AGT(J)                "R26#13":
             NEXT J
             PRINT '  Last PayAmt: ':LPAMT  "R26,#12"
          END

          PRINT
          PRINT 'Typ. Ship Qty.. St Product Description................Per  RegPrice  NetPrice   ':
          IF PRNT.COST THEN PRINT COST.HDR:" ":
          PRINT 'ExtPrice  ':
          IF PRNT.COST THEN PRINT 'GP  ':
          PRINT 'Basis.... Formula.... Avail'
          RETURN
*-------------------------------------------------------------------------*
SEL.IDS:  SORTBYS = ''
          IDS     = ''

          IF BATCH.MODE THEN
             CMD = 'SELECT PRINT.QUEUE '
             IF XFER.OPT # 'Only'THEN CMD := 'WITH STATUS "I" '
             IF XFER.OPT = 'Include' THEN CMD := ' OR'
             IF XFER.OPT # 'Exclude' THEN
                CMD := ' WITH (STATUS "S" AND @ID = "T]")'
             END
             CMD := ' AND WITH PRT.STATUS "P"'
             EXECUTE CMD CAPTURING MSG

             READLIST ID.LIST SETTING ID.CT ELSE ID.CT = 0
             *** For each of the records we picked up...
             FOR D = 1 TO ID.CT
                ID = ID.LIST<D>
                GOSUB ADD.ID
             NEXT D
          END ELSE
             BEGIN CASE
             CASE XFER.OPT = 'Only'
                TYPES = 5
             CASE XFER.OPT = 'Include'
                TYPES = 1:VM:5
             CASE XFER.OPT = 'Exclude'
                TYPES = 1
             END CASE
             TYP.CNT = DCOUNT(TYPES,VM)
             FOR TYP = 1 TO TYP.CNT
                JLI.SELECT MESS,SD,ED,,TYPES<1,TYP>

                *** For each of the records we picked up...
                LOOP
                   READNEXT ID ELSE EXIT
                   GOSUB ADD.ID
                REPEAT
             NEXT TYP
          END

          RETURN
*-------------------------------------------------------------------------*
ADD.ID:   * Filter our AR Record and then save it for display on the
          * report...

          OID = FIELD(ID,'.',1)
          IDX = FIELD(ID,'.',2)+0





          MATREAD LED FROM LEDFILE,OID                    ELSE RETURN

          IF BATCH.MODE THEN
             LOCATE IDX IN LED(12)<1> SETTING GEN         ELSE RETURN
          END ELSE
             LOCATE IDX IN LED(8)<1>  SETTING GEN         ELSE RETURN
          END

          MODE = OID[1,1]
          IF MODE = 'T' THEN
             IF LED(6)<1,GEN> # 'S' THEN RETURN
          END

          *** If the User wanted to Select data by the Pricing Branch...
          IF SBR[1,1] = 'P' THEN
             BR = LED(2)<1,GEN,1>
          END ELSE
             BR = LED(2)<1,GEN,2>
          END

          LOCATE BR IN BRCHS<1> SETTING X                 ELSE RETURN
          IF BATCH # '' AND BATCH # LED(28)<1,GEN>        THEN RETURN
          IF ED    # '' AND (LED(9)<1,GEN> > ED)          THEN RETURN

          *** Filter against any 'Additional Select' values...
          IF FILTER.FLAG THEN
             FILTER.SELECT SKIP.FLAG,OID,GEN,FITEM
             IF SKIP.FLAG THEN RETURN
          END

          LID = OID:'.':LED(12)<1,GEN>

          BEGIN CASE
          CASE SORT.OPT = 'P'
             READV LOG FROM LEDLFILE,OID,10 ELSE LOG = ''
             MSG = 'Processed Order # ':OID:'.':LED(8)<1,GEN>"R%3"
             FINDSTR MSG IN LOG SETTING XX,POS ELSE POS = 1
             SORTBY = LOG<1,POS,2>"R%5":'!':LOG<1,POS,3>"R%5":'!':ID
          CASE SORT.OPT = 'E'
             READV LOG FROM LEDLFILE,OID,10 ELSE LOG = ''
             SORTBY = LOG<1,1,2>"R%5":'!':LOG<1,1,3>"R%5":'!':ID
          CASE SORT.OPT = 'C'
             CN = LED(1)<1,GEN>
             READV CSORT FROM CUSFILE,CN,8 ELSE CSORT = ''
             SORTBY = CSORT:'!':CN:'!':ID
          CASE SORT.OPT = 'S'
             SHIP.VIA = LED(70)<1,GEN>
             SORTBY = SHIP.VIA:'!':ID
          CASE SORT.OPT = 'M'
             SORTBY = '!':ID
             READV LEDL17 FROM LEDLFILE,OID,17 THEN
                MNFST.ID = LEDL17<1,GEN>
                IF MNFST.ID # '' THEN
                   UT.OPEN.FILE 'MANIFESTS',MNFSTFILE,ERR.MSG,YES
                   IF ERR.MSG = '' THEN
                      READ MNFST FROM MNFSTFILE,MNFST.ID THEN
                         TKT.ID = OID:'.':LED(8)<1,GEN>"R%3"
                         TKTS = MNFST<15>
                         CONVERT VM TO SVM IN TKTS
                         LOCATE TKT.ID IN TKTS<1,1> SETTING POS THEN
                            SORTBY = MNFST.ID:POS"R%4":SORTBY
                         END
                      END
                   END
                END
             END
          CASE OTHERWISE
             SORTBY = ID
          END CASE

          LOCATE SORTBY IN SORTBYS BY 'AL' SETTING POS ELSE NULL
          SORTBYS = INSERT(SORTBYS,POS;SORTBY)
          IDS     = INSERT(IDS,POS;LID)

          IF SET.STAT THEN
             READV INV.CT FROM CUSFILE,LED(1)<1,GEN>,50 ELSE INV.CT = 0
             READV DUP.CT FROM CUSFILE,LED(5)<1,GEN>,50 ELSE DUP.CT = ''
             FAX.CT = DUP.CT<1,2>
             DUP.CT = DUP.CT<1,1>
             IF DUP.CT = '' THEN DUP.CT = INV.CT<1,1>
             IF DUP.CT = '' THEN DUP.CT = 1
             IF FAX.CT = '' THEN FAX.CT = INV.CT<1,2>
             IF FAX.CT = 'E' THEN
                FAX.CT  = 100
             END
             IF FAX.CT = '' OR NOT(NUM(FAX.CT)) THEN
                FAX.CT  = 0
             END

             PRT.STAT = 'B'
             CREDIT.CARD.CHK.PRT.ST PRT.STAT,OID,GEN
             READ UNPD.INV FROM CTRBFILE,'PAID.INVS.PRT~':BR ELSE UNPD.INV = ''
             IF PRT.STAT = 'C' AND UNPD.INV= 'N' THEN
                AR.ID = OID : '.' : GEN "R%3"
                READV OP.BAL FROM ARFILE,AR.ID,8 ELSE OP.BAL = 0
                IF NOT(OP.BAL) THEN PRT.STAT = 'N'
             END

             IF DUP.CT = 0 AND FAX.CT = 0 AND PRT.STAT = 'B' THEN
                PRT.STAT = 'N'
             END

             READV OLD.STATS FROM LEDLFILE,OID,9 ELSE
                OLD.STATS = ''
             END

             OLD.PRT.STAT = OLD.STATS<1,GEN>
             IF OLD.PRT.STAT = 'P' THEN
                IF NEW.BATCH.ID # '' THEN
                   * Attempt to lock the order. Check to see if there are
                   * any errors reading from disk. If not, we can continue.
                   * We will wait for any locks to be released before
                   * continuing.
                   OE.LOCK.LED OID,,YES,-1,,LED.ERR,YES
                   IF NOT(LED.ERR) THEN
                      LED(28)<1,GEN> = NEW.BATCH.ID
                      MATWRITE LED ON LEDFILE,OID
                   END
                   OE.UNLOCK.LED OID
                END
             END

             IF HAJOCA.SITE$ AND PRT.STAT = 'N' THEN
                *** For Hajoca sites save the print queue record so that
                *** soe print invoice can properly select the unpaid
                *** invoice report.
                PQ.ID = OID:'.':LED(12)<1,GEN>
                READ PQREC FROM PQFILE,PQ.ID ELSE PQREC = ''
                OE.UPD.PRINT.STAT OID,GEN,PRT.STAT
                OE.ADD.COMMENT OID,GEN,'Prt Status changed to : ':PRT.STAT
                PQREC<5> = PRT.STAT
                WRITE PQREC ON PQFILE,PQ.ID
             END ELSE
                OE.UPD.PRINT.STAT OID,GEN,PRT.STAT
                OE.ADD.COMMENT OID,GEN,'Prt Status changed to : ':PRT.STAT
             END
          END

          RETURN
*-------------------------------------------------------------------------*
ONE.ID.ORIG:   ID  = IDS<IDX>
          OID = FIELD(ID,'.',1)
          GID = FIELD(ID,'.',2)
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED=''

          LOCATE GID IN LED(12)<1> SETTING GEN ELSE RETURN
          IF LED(6)<1,GEN>='X' THEN RETURN
          SAVE.COMMENT = ''

          GOSUB HEADLINE

          LDIDS = RAISE(LED(48)<1,GEN>)
          LDN   = DCOUNT(LDIDS,VM)

*******************
          FOR LDX = 1 TO LDN
             GOSUB ONE.PN.ORIG
          NEXT LDX

          OE.ORDER.TOTAL OID:VM:BASE.CUR,GEN,QSIGN,TOTAL,SUB.TOL,FGHT,HNDL,TAX.TOL,FET.TOL
          TAX.TOL += FET.TOL
          IF CURR.FLG THEN
             CONV.CURR.LED TGT,GEN
          END

          BIL.INFRT   = LED(36)<1,GEN,3>*QSIGN
          BIL.OUTFRT  = LED(36)<1,GEN,4>*QSIGN
          BIL.INHNDL  = LED(36)<1,GEN,7>*QSIGN
          BIL.OUTHNDL = LED(36)<1,GEN,8>*QSIGN
          EXP.INFRT   = LED(36)<1,GEN,5>*QSIGN
          EXP.OUTFRT  = LED(36)<1,GEN,6>*QSIGN
          EXP.INHNDL  = LED(36)<1,GEN,9>*QSIGN
          EXP.OUTHNDL = LED(36)<1,GEN,10>*QSIGN
          GRAND.SBTOTAL += OCONV(SUB.TOL,'MR2')

          PRINT
          PRINT 'Subtotal :':OCONV(SUB.TOL,'MR2')         "R2#10":'  ':
          PRINT 'Tax :':OCONV(TAX.TOL,'MR2')              "R2#10":'  ':
          PRINT 'Freight :':OCONV(FGHT,'MR2')             "R2#10":'  ':
          PRINT 'Handling : ':OCONV(HNDL,'MR2')           "R2#10":'  ':
          INV.AMT = SUB.TOL + FGHT + HNDL + TAX.TOL
          PRINT 'Invoice Total : ':OCONV(INV.AMT,'MR2')   "R2#10":'  ':

*******************
          IF PRNT.COST THEN
             IF COST.TYPE=2 THEN
                ADJ.COGS = -LED(16)<1,GEN>
             END ELSE
                ADJ.COGS = -LED(17)<1,GEN>
             END
             TOL.COGS = ADJ.COGS - EXP.INFRT - EXP.OUTFRT - EXP.INHNDL - EXP.OUTHNDL

             GRAND.COST += (TOL.COGS/100)
             PRINT 'Goods GP % ':
             IF SUB.TOL=0 THEN GP=0 ELSE
                GP = 100*(SUB.TOL-TOL.COGS)/SUB.TOL
                IF GP <= -1000 THEN GP = -999
                IF GP >= 10000 THEN GP = 9999
             END
             PRINT GP "R0#4"
          END ELSE
             PRINT
          END

*** Print freight and handling break out
          PRINT "Freight and Handling Distribution :"
          PRINT "Freight In :": OCONV(BIL.INFRT ,'MR2')   "R2#10":'  ':
          PRINT "Freight Out :":OCONV(BIL.OUTFRT,'MR2')   "R2#10":'  ':
          PRINT "Handling In :": OCONV(BIL.INHNDL ,'MR2')  "R2#10":'  ':
          PRINT "Handling Out :":OCONV(BIL.OUTHNDL,'MR2')  "R2#10":'  ':
          IF PRNT.COST THEN
             PRINT '             Adj GP % ':
             GRAND.ADJ += ADJ.COGS
             IF SUB.TOL=0 THEN AGP=0 ELSE
                AGP = 100*(SUB.TOL-ADJ.COGS)/SUB.TOL
                IF AGP <= -1000 THEN AGP = -999
                IF AGP >= 10000 THEN AGP = 9999
             END
             PRINT AGP "R0#4"
             PRINT "Exp Frt In :":OCONV(EXP.INFRT,'MR2')     "R2#10":'  ':
             PRINT "Exp Frt Out :":OCONV(EXP.OUTFRT,'MR2')   "R2#10":'  ':
             PRINT "Exp Hndl In :":OCONV(EXP.INHNDL,'MR2')  "R2#10":'  ':
             PRINT "Exp Hndl Out :":OCONV(EXP.OUTHNDL,'MR2') "R2#10":'  '
          END ELSE
             PRINT
          END

          READ ARREC FROM ARFILE,OID:'.':LED(8)<1,GEN>"R%3" ELSE ARREC = ''
          ASUB.GET.AMT PAMT,ARREC,2,,GL.AUTO.AR
          IF PAMT THEN
             PRINT STR(' ',82):
             PRINT '** Amount Paid : ':PAMT "R26,#10"
          END
          PRINT
          PRINT STR('*',120)
          PRINT

          PRINT.CT = PRINT.CT + 1

          RETURN
*-------------------------------------------------------------------------*
ONE.PN.ORIG:   LDID = LDIDS<1,LDX>
          IF NUM(LDID) THEN
             LD.GET LDID
             IF CURR.FLG THEN
                CONV.CURR.LD TGT,GEN
             END

             BEGIN CASE
             * If Product Number or Job Managment Line Item
             CASE NUM(LD(1)) OR LD(1)[1,2] = "L#"
                PN   = LD(1)
                OE.GET.LI.OVRD.FLAG '1',GEN,GEN,OVRD.FLG,LDID,1
                PRC.OVRD.TYP = OVRD.FLG
                OE.GET.LI.OVRD.FLAG '2',GEN,GEN,OVRD.FLG,LDID,1
                COGS.OVRD.TYP = OVRD.FLG
                OE.GET.LI.OVRD.FLAG '3',GEN,GEN,OVRD.FLG,LDID,1
                COST.OVRD.TYP = OVRD.FLG
                GET.ALL.PRD BR,PN
                QTY  = -(SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>))
                OE.CALC.QOPEN OID,QSIGN,QOPEN
                QOPEN += QTY
                NP   = LD(8)<1,GEN>+0
                CST  = LD(COST.BASE)<1,GEN>+0
*************************
                IQP  = LD(9)<1,GEN>
                STAT = PRD(3)
                STS  = STATUS<1,STAT>
                BASN = LD(15)<1,GEN,2>
                IF BASN THEN
                   BEGIN CASE
                   CASE BASN = 21;      BASN = 'Lnd Cost'
                   CASE BASN = 22;      BASN = 'Avg Lnd'
                   CASE BASN = 25;      BASN = 'Order COGS'
                   CASE BASN = 28;      BASN = 'Order Comm'
                   CASE OTHERWISE
                      BASN = PLNE(2)<1,BASN>
                   END CASE
                   FORM = LD(15)<1,GEN,1>
                END ELSE
                   BASN = ''
                   FORM = ''
                END
                IF PRD(3) = '9' THEN IS.LOT = YES ELSE IS.LOT = NO
                GOSUB PR.PN
                IF IS.LOT THEN GOSUB PRT.LOT
             CASE LD(1) = 'C'
                SAVE.COMMENT = RAISE(LD(3))
                DCT = DCOUNT(SAVE.COMMENT,VM)

                *** Precede the first line of our Comment with an asteric
                *** so that they stand out from other types of Comments...
                PRINT SPACE(19):'*':SAVE.COMMENT<1,1>  "L#35"

                *** Print the rest of our comment lines...
                FOR JJ = 2 TO DCT
                   PRINT SPACE(19):SAVE.COMMENT<1,JJ>  "L#35"
                NEXT JJ
                SAVE.COMMENT = ''
             CASE LD(1) = 'S'
                SAVE.COMMENT = ''
             END CASE
          END

          RETURN
*-------------------------------------------------------------------------*
!TSMITH~01/14/14~10:41
